home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / ALLOC.INC < prev    next >
Text File  |  1991-11-09  |  4KB  |  122 lines
  1. { Memory allocation functions for SURFMODL }
  2.  
  3. {$ifdef BIGMEM}
  4.  
  5. function ALLOC_NODES: boolean;
  6. { Allocate sufficient memory for Nnodes nodes, return TRUE if OK or
  7.   FALSE if out of memory.
  8. }
  9.  
  10. begin
  11.  
  12.   ALLOC_NODES := TRUE;
  13.   if (Nnodes > MAXNODES) then begin
  14.     { Not enough memory, get more.  First free up the old arrays if they
  15.       were already allocated.
  16.     }
  17.     if (MAXNODES > 0) then begin
  18.       freemem (ptra, MAXNODES * sizeof(real));
  19.       freemem (ptrb, MAXNODES * sizeof(real));
  20.       freemem (ptrc, MAXNODES * sizeof(real));
  21.       freemem (ptrd, MAXNODES * sizeof(real));
  22.       freemem (ptre, MAXNODES * sizeof(real));
  23.       freemem (ptrf, MAXNODES * sizeof(real));
  24.       freemem (ptrj, MAXNODES * sizeof(real));
  25.       freemem (ptrl, MAXNODES * sizeof(integer));
  26.     end;
  27.  
  28.     { KVC 11/09/91 No longer need to check for available memory before
  29.       the getmem() call, since HeapErrorTrap now stops the Error 203's.
  30.     }
  31.     getmem (ptra, Nnodes * sizeof(real));
  32.     getmem (ptrb, Nnodes * sizeof(real));
  33.     getmem (ptrc, Nnodes * sizeof(real));
  34.     getmem (ptrd, Nnodes * sizeof(real));
  35.     getmem (ptre, Nnodes * sizeof(real));
  36.     getmem (ptrf, Nnodes * sizeof(real));
  37.     getmem (ptrj, Nnodes * sizeof(real));
  38.     getmem (ptrl, Nnodes * sizeof(integer));
  39.  
  40.     if (ptra = NIL) or (ptrb = NIL) or (ptrc = NIL) or (ptrd = NIL) or
  41.        (ptre = NIL) or (ptrf = NIL) or (ptrj = NIL) or (ptrl = NIL) then begin
  42.       { Error - out of memory }
  43.       ALLOC_NODES := FALSE;
  44.       MAXNODES := 0;
  45.       if (ptra <> NIL) then
  46.         freemem (ptra, Nnodes * sizeof(real));
  47.       if (ptrb <> NIL) then
  48.         freemem (ptrb, Nnodes * sizeof(real));
  49.       if (ptrc <> NIL) then
  50.         freemem (ptrc, Nnodes * sizeof(real));
  51.       if (ptrd <> NIL) then
  52.         freemem (ptrd, Nnodes * sizeof(real));
  53.       if (ptre <> NIL) then
  54.         freemem (ptre, Nnodes * sizeof(real));
  55.       if (ptrf <> NIL) then
  56.         freemem (ptrf, Nnodes * sizeof(real));
  57.       if (ptrj <> NIL) then
  58.         freemem (ptrj, Nnodes * sizeof(real));
  59.       if (ptrl <> NIL) then
  60.         freemem (ptrl, Nnodes * sizeof(integer));
  61.     end else
  62.       MAXNODES := Nnodes;
  63.   end; { if Nnodes > MAXNODES }
  64. end; { function ALLOC_NODES }
  65.  
  66.  
  67. function ALLOC_SURFS: boolean;
  68. { Allocate sufficient memory for Nsurf surfaces, return TRUE if OK or
  69.   FALSE if out of memory.
  70. }
  71.  
  72. begin
  73.  
  74.   ALLOC_SURFS := TRUE;
  75.   if (Nsurf > MAXSURF) or (Nsurf * Maxvert > MAXCONNECT) then begin
  76.     { Not enough memory, get more.  First free up the old arrays if they
  77.       were already allocated.
  78.     }
  79.     if (MAXCONNECT > 0) then
  80.       freemem (ptrg, MAXCONNECT * sizeof(integer));
  81.     if (MAXSURF > 0) then begin
  82.       freemem (ptrh, MAXSURF * sizeof(integer));
  83.       freemem (ptri, MAXSURF * sizeof(integer));
  84.       freemem (ptrk, MAXSURF * sizeof(real));
  85.       freemem (ptrm, MAXSURF * sizeof(real));
  86.       freemem (ptrn, MAXSURF * sizeof(real));
  87.     end;
  88.  
  89.     getmem (ptrg, Nsurf * Maxvert * sizeof(integer));
  90.     getmem (ptrh, Nsurf * sizeof(integer));
  91.     getmem (ptri, Nsurf * sizeof(integer));
  92.     getmem (ptrk, Nsurf * sizeof(real));
  93.     getmem (ptrm, Nsurf * sizeof(real));
  94.     getmem (ptrn, Nsurf * sizeof(real));
  95.  
  96.     if (ptrg = NIL) or (ptrh = NIL) or (ptri = NIL) or (ptrk = NIL) or
  97.        (ptrm = NIL) or (ptrn = NIL) then begin
  98.       { Error - out of memory }
  99.       ALLOC_SURFS := FALSE;
  100.       MAXSURF := 0;
  101.       MAXCONNECT := 0;
  102.       if (ptrg <> NIL) then
  103.         freemem (ptrg, Nsurf * Maxvert * sizeof(integer));
  104.       if (ptrh <> NIL) then
  105.         freemem (ptrh, Nsurf * sizeof(integer));
  106.       if (ptri <> NIL) then
  107.         freemem (ptri, Nsurf * sizeof(integer));
  108.       if (ptrk <> NIL) then
  109.         freemem (ptrk, Nsurf * sizeof(real));
  110.       if (ptrm <> NIL) then
  111.         freemem (ptrm, Nsurf * sizeof(real));
  112.       if (ptrn <> NIL) then
  113.         freemem (ptrn, Nsurf * sizeof(real));
  114.     end else begin
  115.       MAXSURF := Nsurf;
  116.       MAXCONNECT := Nsurf * Maxvert;
  117.     end;
  118.   end; { if Nsurf > MAXSURF... }
  119. end; { function ALLOC_SURFS }
  120.  
  121. {$endif} { BIGMEM }
  122.